"Info": "Function dbSelect% (ByVal strDatabaseName$, ByVal strSQL$, ByVal intNumCols%, DataBuff() as Fields)\r\n\r\nStatic intCount%\r\nDim ds As Dynaset\r\nDim db As Database\r\n\r\n'Allows for a maximum of 1000 records\r\nReDim DataBuff(intNumCols, 1000)\r\n\r\nOn Error GoTo ErrHandle\r\n\r\nSet db = OpenDatabase(gstrDatabaseName, True, True)\r\n\r\nstrSQL = \"Select * from [\" & gstrOldPlayerTable & \"] where \"\r\nset ds = db.CreateDynaset(strSQL)\r\nIf ds.EOF Then\r\n 'No data found\r\nElse\r\n ds.MoveFirst\r\n\tDataBuff(1) = ds\r\nEnd If\r\n\r\nintCount = 0\r\nDo While Not ds.EOF\r\n\tintCount% = intCount+1\r\n\tDataBuff(intCount) = ds\t\r\nLoop\r\n\r\nds.Close\r\ndb.Close\r\n\r\ndbSelect = intCount\r\n\r\nExit Sub\r\n\r\nErrHandle:\r\nMsgBox \"Database Error\", 16, \"Error\"\r\nExit Sub\r\nResume\r\n\r\nEnd Function"
},
{
"Group": "Array",
"Item": "sArrayIsIn% ",
"Info": "Function sArrayIsIn% (ByVal strIn$, strArray$())\r\n'Tells if a string is in an array\r\n\r\nStatic intCountList%\r\n \r\nFor intCountList = LBound(strArray) To UBound(strArray)\r\n If strArray(intCountList) = strIn Then\r\n sArrayIsIn = intCountList\r\n Exit For\r\n End If\r\nNext intCountList\r\n\r\nEnd Function"
},
{
"Group": "File",
"Item": "File_IO ",
"Info": "Sub File_IO (strAction$)\r\n\r\nStatic flgFound%, intCount%, intCount2%\r\n\r\n flgFound = False\r\n MainForm.CMDialog1.InitDir = gstrMainDirectory\r\n MainForm.CMDialog1.Filename = \"*.*\"\r\n MainForm.CMDialog1.DefaultExt = \"\"\r\n MainForm.CMDialog1.Filter = \"Text Files (*.TXT)|*.TXT|All Files (*.*)|*.*\"\r\n MainForm.CMDialog1.FilterIndex = 1\r\n Select Case strAction\r\n Case \"DELETE\"\r\n Do\r\n MainForm.CMDialog1.Filename = gudtMDIChild(Val(ActiveForm.Tag)).strFileName\r\n MainForm.CMDialog1.DialogTitle = \"Delete File\"\r\n MainForm.CMDialog1.Action = 2 'Set for file save dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n 'asdasd\r\n Else\r\n Exit Sub\r\n End If\r\n If FileExists(SaveName) Then\r\n Res% = MsgBox(\"OK to delete \" & SaveName & \"?\", 52, \"Delete File\")\r\n Else\r\n Res% = 6\r\n End If\r\n Loop While Res% <> 6\r\n Screen.MousePointer = 11\r\n If FileExists(SaveName) Then Kill SaveName\r\n Screen.MousePointer = 0\r\n \r\n Case \"UPDATE\"\r\n SaveName = gudtMDIChild(Val(ActiveForm.Tag)).strFileName\r\n If SaveName = \"\" Then\r\n MainForm.CMDialog1.DialogTitle = \"Save File\"\r\n MainForm.CMDialog1.Action = 2 'Set for file save dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n gudtMDIChild(Val(ActiveForm.Tag)).strFileName = SaveName\r\n Else\r\n Exit Sub\r\n End If\r\n End If\r\n Screen.MousePointer = 11\r\n If FileExists(SaveName) Then Kill SaveName 'Blank out File\r\n gudtMDIChild(Val(ActiveForm.Tag)).flgSaved = True\r\n Screen.MousePointer = 0\r\n Case \"SAVEAS\"\r\n Do\r\n MainForm.CMDialog1.Filename = gudtMDIChild(Val(ActiveForm.Tag)).strFileName\r\n MainForm.CMDialog1.DialogTitle = \"Save File\"\r\n MainForm.CMDialog1.Action = 2 'Set for file save dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n gudtMDIChild(Val(ActiveForm.Tag)).strFileName = SaveName\r\n gudtMDIChild(Val(ActiveForm.Tag)).TradePlan = SaveName\r\n Else\r\n Exit Sub\r\n End If\r\n If FileExists(SaveName) Then\r\n Res% = MsgBox(\"OK to overwrite existing \" & SaveName & \"?\", 52, \"Save File\")\r\n Else\r\n Res% = 6\r\n End If\r\n Loop While Res% <> 6\r\n Screen.MousePointer = 11\r\n If FileExists(SaveName) Then Kill SaveName\r\n\t\t\tWriteInfo(SaveName)\r\n frmMDIChild(Val(ActiveForm.Tag)).Caption = sGetFileName(SaveName)\r\n For intCount = 1 To gudtMDIChild(Val(ActiveForm.Tag)).NumPanels\r\n GraphDefArray(CTP, intCount).Caption = frmMDIChild(Val(ActiveForm.Tag)).Caption & \" - \" & \" Graph \" & Format$(intCount)\r\n Next intCount\r\n gudtMDIChild(Val(ActiveForm.Tag)).flgSaved = True\r\n Screen.MousePointer = 0\r\n Case \"LOAD\"\r\n MainForm.CMDialog1.DialogTitle = \"Open File\"\r\n MainForm.CMDialog1.Action = 1 'Set for file open dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n Screen.MousePointer = 11\r\n giActiveChild = GetNewChild()\r\n\t\t\t\tIf giActiveChild > 0 then\r\n\t\t\t\t\t'Open an MDI Child\r\n \t gudtMDIChild(Val(ActiveForm.Tag)).strFileName = SaveName\r\n\t\t\t\t\tLoadFile giActiveChild\r\n \t gudtMDIChild(Val(ActiveForm.Tag)).flgSaved = True\r\n\t\t\t\tElse\r\n\t\t\t\t\t'No room to open a new form\r\n\t\t\t\tEnd If\r\n Screen.MousePointer = 0\r\n End If\r\n\t\tCase Else\r\n\t\t\tMsgBox \"Invalid File I/O call.\"\r\n End Select\r\nEnd Sub"
"Info": "Function GetFileName$ (ByVal strFileName$)\r\n'Strip off directory and .DBF for use in table joining queries\r\n\r\nStatic intPosition%, flgSlashFound%, intTemp%\r\n\r\nIf InStr(Right$(strFileName, 4), \".\") > 0 then\r\n'If there is a tail on the file name\r\n\tstrFileName = Left$(strFileName, Len(strFileName) - 4)\r\nEnd If\r\n\r\nintPosition = 1\r\n\r\nDo\r\n flgSlashFound = False\r\n intTemp = InStr(intPosition, strFileName, \"\\\")\r\n flgSlashFound = Not intTemp = 0\r\n If flgSlashFound Then intPosition = intTemp + 1\r\nLoop While flgSlashFound\r\n\r\nGetFileName = Right$(strFileName, Len(strFileName) - intPosition + 1)\r\n\r\nEnd Function"
},
{
"Group": "List Box",
"Item": "Is in List",
"Info": "Function cListIsIn% (lstListBox As Control, ByVal strIn$)\r\n\r\nStatic flgTemp%, intCountList%\r\n\r\nflgTemp = False\r\nFor intCountList = 0 To lstListBox.ListCount - 1\r\n If lstListBox.List(intCountList) = strIn Then\r\n flgTemp = True\r\n Exit For\r\n End If\r\nNext intCountList\r\ncListIsIn = flgTemp\r\n\r\nEnd Function"
},
{
"Group": "List Box",
"Item": "Number Selected",
"Info": "Function cListNumSelected% (lstListBox As Control)\r\n'Returns the number of items selected in a list box\r\n\r\nStatic intTemp%, intCountList%\r\n\r\nintTemp = 0\r\nFor intCountList = 1 To lstListBox.ListCount\r\n If lstListBox.Selected(intCountList - 1) Then\r\n intTemp = intTemp + 1\r\n End If\r\nNext intCountList\r\n\r\ncListNumSelected = intTemp\r\n\r\nEnd Function"
},
{
"Group": "List Box",
"Item": "Set List Box ",
"Info": "Sub cListSet (lstBox As Control, ByVal strNewText$)\r\n'Sets a list box to the given text if it is in the list\r\n'If not it un-sets the list box\r\n\r\nStatic intCount%, flgFound%\r\n \r\nflgFound = False\r\nintCount = 0\r\ngflgClickBypass = True\r\n\r\nDo While intCount < lstBox.ListCount And flgFound = False\r\n intCount = intCount + 1\r\n If lstBox.List(intCount - 1) = strNewText Then\r\n lstBox.ListIndex = intCount - 1\r\n flgFound = True\r\n End If\r\nLoop\r\n\r\nIf flgFound = False Then\r\n lstBox.ListIndex = -1\r\nEnd If\r\n\r\ngflgClickBypass = False\r\n\r\nEnd Sub"
"Info": "Function SetBinaryIncluded%(intIn%, intPlace%, flgIn%)\r\n\r\nIf IsBinaryIncluded(intIn, intPlace) and Not flgIn Then\r\n intIn = intIn + 2 ^ intPlace\r\nElseIf Not IsBinaryIncluded(intIn, intPlace) and flgIn Then\r\n intIn = intIn - 2 ^ intPlace\r\nEnd If\r\n\r\nEnd Function"
},
{
"Group": "MDI",
"Item": "(General)",
"Info": "MAXCHILDWINDOWS = 10\r\n\r\nType MDIChildType\r\n flgInUse As Integer\r\n flgSaved As Integer\r\n\tstrFileName as String\r\n hWnd As Integer\r\nEnd Type\r\nGlobal gudtMDIChild(MAXCHILDWINDOWS) As MDIChildType\r\n\r\nGlobal gintActiveChild%\r\n\r\nGlobal frmCodeChild(MAXCHILDWINDOWS) As New frmCode"
},
{
"Group": "MDI",
"Item": "File_IO ",
"Info": "Sub File_IO (strAction$)\r\n\r\nStatic flgFound%, intCount%, intCount2%\r\n\r\n flgFound = False\r\n MainForm.CMDialog1.InitDir = gstrMainDirectory\r\n MainForm.CMDialog1.Filename = \"*.*\"\r\n MainForm.CMDialog1.DefaultExt = \"\"\r\n MainForm.CMDialog1.Filter = \"Text Files (*.TXT)|*.TXT|All Files (*.*)|*.*\"\r\n MainForm.CMDialog1.FilterIndex = 1\r\n Select Case strAction\r\n Case \"DELETE\"\r\n Do\r\n MainForm.CMDialog1.Filename = gudtMDIChild(Val(ActiveForm.Tag)).strFileName\r\n MainForm.CMDialog1.DialogTitle = \"Delete File\"\r\n MainForm.CMDialog1.Action = 2 'Set for file save dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n 'asdasd\r\n Else\r\n Exit Sub\r\n End If\r\n If FileExists(SaveName) Then\r\n Res% = MsgBox(\"OK to delete \" & SaveName & \"?\", 52, \"Delete File\")\r\n Else\r\n Res% = 6\r\n End If\r\n Loop While Res% <> 6\r\n Screen.MousePointer = 11\r\n If FileExists(SaveName) Then Kill SaveName\r\n Screen.MousePointer = 0\r\n \r\n Case \"UPDATE\"\r\n SaveName = gudtMDIChild(Val(ActiveForm.Tag)).strFileName\r\n If SaveName = \"\" Then\r\n MainForm.CMDialog1.DialogTitle = \"Save File\"\r\n MainForm.CMDialog1.Action = 2 'Set for file save dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n gudtMDIChild(Val(ActiveForm.Tag)).strFileName = SaveName\r\n Else\r\n Exit Sub\r\n End If\r\n End If\r\n Screen.MousePointer = 11\r\n If FileExists(SaveName) Then Kill SaveName 'Blank out File\r\n\t\t\tSaveFile SaveName, Val(ActiveForm.Tag) \r\n gudtMDIChild(Val(ActiveForm.Tag)).flgSaved = True\r\n Screen.MousePointer = 0\r\n Case \"SAVEAS\"\r\n Do\r\n MainForm.CMDialog1.Filename = gudtMDIChild(Val(ActiveForm.Tag)).strFileName\r\n MainForm.CMDialog1.DialogTitle = \"Save File\"\r\n MainForm.CMDialog1.Action = 2 'Set for file save dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n gudtMDIChild(Val(ActiveForm.Tag)).strFileName = SaveName\r\n gudtMDIChild(Val(ActiveForm.Tag)).TradePlan = SaveName\r\n Else\r\n Exit Sub\r\n End If\r\n If FileExists(SaveName) Then\r\n Res% = MsgBox(\"OK to overwrite existing \" & SaveName & \"?\", 52, \"Save File\")\r\n Else\r\n Res% = 6\r\n End If\r\n Loop While Res% <> 6\r\n Screen.MousePointer = 11\r\n If FileExists(SaveName) Then Kill SaveName\r\n\t\t\tSaveFile SaveName, Val(ActiveForm.Tag)\r\n frmMDIChild(Val(ActiveForm.Tag)).Caption = sGetFileName(SaveName)\r\n gudtMDIChild(Val(ActiveForm.Tag)).flgSaved = True\r\n Screen.MousePointer = 0\r\n Case \"LOAD\"\r\n MainForm.CMDialog1.DialogTitle = \"Open File\"\r\n MainForm.CMDialog1.Action = 1 'Set for file open dialog box\r\n SaveName = MainForm.CMDialog1.Filename\r\n If InStr(SaveName, \"*\") = 0 And SaveName <> \"\" And SaveName = UCase$(SaveName) Then\r\n Screen.MousePointer = 11\r\n giActiveChild = GetNewChild()\r\n\t\t\t\tIf giActiveChild > 0 then\r\n\t\t\t\t\t'Open an MDI Child\r\n \t gudtMDIChild(Val(ActiveForm.Tag)).strFileName = SaveName\r\n\t\t\t\t\tLoadFile SaveName, giActiveChild\r\n \t gudtMDIChild(Val(ActiveForm.Tag)).flgSaved = True\r\n\t\t\t\tElse\r\n\t\t\t\t\t'No room to open a new form\r\n\t\t\t\t\tMsgBox \"Too many windows open already.\"\r\n\t\t\t\tEnd If\r\n Screen.MousePointer = 0\r\n End If\r\n\t\tCase Else\r\n\t\t\tMsgBox \"Invalid File I/O call.\"\r\n End Select\r\nEnd Sub"
"Info": "Sub mnuFileNew_Click ()\r\n\r\nStatic intCount%, flgFound%\r\n\r\nflgFound = False\r\n\r\nFor intCount = 1 To MAXCHILDWINDOWS\r\n If gflgFormInUse(intCount) = False Then\r\n frmCodeChild(intCount).Caption = \"Untitled\" & intCount\r\n frmCodeChild(intCount).Tag = Format$(intCount)\r\n gudtMDIChild(intCount).flgInUse = True\r\n gudtMDIChild(intCount).flgSaved = -2\r\n frmCodeChild(intCount).Show\r\n flgFound = True\r\n Exit For\r\n End If\r\nNext intCount\r\n\r\nIf Not flgFound Then MsgBox MAXCHILDWINDOWS & \" windows already open.\"\r\n\r\nEnd Sub"
},
{
"Group": "MDI",
"Item": "ChildForm_Unload ",
"Info": "Sub ChildForm_Unload (Cancel%)\r\n'Make sure the form is saved before quiting\r\n\r\nIf gflgMDIChild(Val(Me.Tag)).flgInUse And gflgMDIChild(Val(Me.Tag)).flgSaved <> -1 Then\r\n Select Case MsgBox(\"Save changes to \" & gflgMDIChild(Val(Me.Tag)).Caption & \"?\", 51, \"Exit\")\r\n Case 2 'Cancel\r\n Cancel = True\r\n Exit Sub\r\n Case 6 'Yes\r\n gintActiveChild = intCount\r\n If gflgMDIChild(Val(Me.Tag)).flgSaved = -2 Then\r\n File_IO \"SAVEAS\", Val(Me.Tag) 'New file to save\r\n Else\r\n File_IO \"UPDATE\", Val(Me.Tag)\r\n End If\r\n Case 7 'No\r\n End Select\r\nEnd If\r\n\r\nEnd Sub"
},
{
"Group": "MDI",
"Item": "MDIForm_Unload ",
"Info": "Sub MDIForm_Unload (Cancel%)\r\n'Make sure all children are saved before quiting\r\n\r\nStatic intCount%\r\n\r\nFor intCount = 1 To MAXCHILDWINDOWS\r\n If gflgMDIChild(intCount).flgInUse And gflgMDIChild(intCount).flgSaved <> -1 Then\r\n\t Select Case MsgBox(\"Save changes to \" & gflgMDIChild(intCount).Caption & \"?\", 51, \"Exit\")\r\n\t\t\tCase 2 'Cancel\r\n\t Cancel = True\r\n\t\t\t Exit Sub\r\n\t\t\tCase 6 'Yes\r\n\t\t\t\tgintActiveChild = intCount\r\n\t\t\t If gflgMDIChild(intCount).flgSaved = -2 Then\r\n\t\t\t\t\tFile_IO \"SAVEAS\", intCount 'New file to save\r\n\t\t\t Else\r\n\t\t\t\t\tFile_IO \"UPDATE\", intCount\r\n\t\t\t End If\r\n\t\t\tCase 7 'No\r\n\t End Select\r\n\tEnd If\r\nNext I\r\n\r\nEnd\r\n\r\nEnd Sub"
"Info": "Sub PrintTextFile (ByVal TextFile$, ByVal intTabWidth%)\r\n\r\nStatic I%\r\nStatic CurrentWord$\r\n\r\n'Set the font here\r\n\r\nArrayPointer = 1\r\nCols(1) = 2000\r\nDefineColumns 2\r\nPrinter.FontName = gudtPrintOptions.PrintingFont\r\nPrintPageNumber\r\nFor I = 1 To Len(TextFile)\r\n CurrentWord = \"\"\r\n If Mid$(TextFile, I, 2) = Chr$(13) & Chr$(10) Then\r\n 'Program prints its own carriage returns\r\n CarriageReturn\r\n I = I + 2\r\n End If\r\n If Printer.CurrentX < gudtPrintOptions.LeftMargin Then Printer.CurrentX = gudtPrintOptions.LeftMargin\r\n 'If Printer.CurrentX + Len(PrintString) > gudtPrintOptions.RightMargin Then Printer.Print\r\n If Mid$(TextFile, I, 1) = chr(9) Then\r\n Printer.Print Spc(intTabWidth);\r\n Else\r\n Printer.Print Mid$(TextFile, I, 1);\r\n End If\r\nNext I\r\nPrinter.EndDoc\r\n\r\nEnd Sub"
},
{
"Group": "Printing",
"Item": "SetCopyCount ",
"Info": "Sub SetCopyCount (ByVal intNumCopies%)\r\n\r\n'Sets the number of copies for the printer setup\r\n\r\nStatic X%, Y%, Actual%\r\n\r\nX = Escape(Printer.hDC, 17, Len(Y), intNumCopies, Actual)\r\n\r\nEnd Sub"
},
{
"Group": "Printing",
"Item": "SetFont ",
"Info": "Sub SetFont (ByVal SizeofFont%, ByVal RegBoldItal%)\r\n'Sets the current font, size, and style\r\n\r\n If SizeofFont > -1 Then Printer.FontSize = SizeofFont\r\n gudtPrintOptions.Spacing = Int(Printer.FontSize * gudtPrintOptions.SpaceMultiplier)\r\n Select Case RegBoldItal\r\n Case 1 'Normal\r\n Printer.FontItalic = False\r\n Printer.FontBold = False\r\n Printer.FontUnderline = False\r\n Case 2 'Bold\r\n Printer.FontItalic = False\r\n Printer.FontBold = True\r\n Printer.FontUnderline = False\r\n Case 3 'Italic\r\n Printer.FontItalic = True\r\n Printer.FontBold = False\r\n Printer.FontUnderline = False\r\n Case 4 'Bold & Italic\r\n Printer.FontItalic = True\r\n Printer.FontBold = True\r\n Printer.FontUnderline = False\r\n Case 5 'Underline\r\n Printer.FontItalic = False\r\n Printer.FontBold = False\r\n Printer.FontUnderline = True\r\n End Select\r\n\r\nEnd Sub"
},
{
"Group": "Text Box",
"Item": "SelectAll ",
"Info": "Sub SelectAll (TextBox As Control)\r\n'Selects all text in a text box\r\n\r\nTextBox.SelStart = 0\r\nTextBox.SelLength = Len(TextBox.Text)\r\n\r\nEnd Sub"
},
{
"Group": "Constants",
"Item": "(General)",
"Info": "''''''''''''''''''''''''''''\r\n' Visual Basic global constant file. This file can be loaded\r\n' into a code module.\r\n'\r\n' Some constants are commented out because they have\r\n' duplicates (e.g., NONE appears several places).\r\n'\r\n' If you are updating a Visual Basic application written with\r\n' an older version, you should replace your global constants\r\n' with the constants in this file.\r\n'\r\n'''''''''''''''''''''''''''''"
"Info": "'OLE Client Control\r\n'Actions\r\nGlobal Const OLE_CREATE_EMBED = 0\r\nGlobal Const OLE_CREATE_NEW = 0 'from ole1 control\r\nGlobal Const OLE_CREATE_LINK = 1\r\nGlobal Const OLE_CREATE_FROM_FILE = 1 'from ole1 control\r\nGlobal Const OLE_COPY = 4\r\nGlobal Const OLE_PASTE = 5\r\nGlobal Const OLE_UPDATE = 6\r\nGlobal Const OLE_ACTIVATE = 7\r\nGlobal Const OLE_CLOSE = 9\r\nGlobal Const OLE_DELETE = 10\r\nGlobal Const OLE_SAVE_TO_FILE = 11\r\nGlobal Const OLE_READ_FROM_FILE = 12\r\nGlobal Const OLE_INSERT_OBJ_DLG = 14\r\nGlobal Const OLE_PASTE_SPECIAL_DLG = 15\r\nGlobal Const OLE_FETCH_VERBS = 17\r\nGlobal Const OLE_SAVE_TO_OLE1FILE = 18\r\n\r\n'OLEType\r\nGlobal Const OLE_LINKED = 0\r\nGlobal Const OLE_EMBEDDED = 1\r\nGlobal Const OLE_NONE = 3\r\n\r\n'OLETypeAllowed\r\nGlobal Const OLE_EITHER = 2\r\n\r\n'UpdateOptions\r\nGlobal Const OLE_AUTOMATIC = 0\r\nGlobal Const OLE_FROZEN = 1\r\nGlobal Const OLE_MANUAL = 2\r\n\r\n'AutoActivate modes\r\n'Note that OLE_ACTIVATE_GETFOCUS only applies to objects that\r\n'support \"inside-out\" activation. See related Verb notes below.\r\nGlobal Const OLE_ACTIVATE_MANUAL = 0\r\nGlobal Const OLE_ACTIVATE_GETFOCUS = 1\r\nGlobal Const OLE_ACTIVATE_DOUBLECLICK = 2\r\n\r\n'SizeModes\r\nGlobal Const OLE_SIZE_CLIP = 0\r\nGlobal Const OLE_SIZE_STRETCH = 1\r\nGlobal Const OLE_SIZE_AUTOSIZE = 2\r\n\r\n'DisplayTypes\r\nGlobal Const OLE_DISPLAY_CONTENT = 0\r\nGlobal Const OLE_DISPLAY_ICON = 1\r\n\r\n'Update Event Constants\r\nGlobal Const OLE_CHANGED = 0\r\nGlobal Const OLE_SAVED = 1\r\nGlobal Const OLE_CLOSED = 2\r\nGlobal Const OLE_RENAMED = 3\r\n\r\n'Special Verb Values\r\nGlobal Const VERB_PRIMARY = 0\r\nGlobal Const VERB_SHOW = -1\r\nGlobal Const VERB_OPEN = -2\r\nGlobal Const VERB_HIDE = -3\r\nGlobal Const VERB_INPLACEUIACTIVATE = -4\r\nGlobal Const VERB_INPLACEACTIVATE = -5\r\n'The last two verbs are for objects that support \"inside-out\" activation,\r\n'meaning they can be edited in-place, and that they support being left\r\n'in-place-active even when the input focus moves to another control or form.\r\n'These objects actually have 2 levels of being active. \"InPlace Active\"\r\n'means that the object is ready for the user to click inside it and start\r\n'working with it. \"In-Place UI-Active\" means that, in addition, if the object\r\n'has any other UI associated with it, such as floating palette windows,\r\n'that those windows are visible and ready for use. Any number of objects\r\n'can be \"In-Place Active\" at a time, although only one can be \r\n'\"InPlace UI-Active\". \r\n\r\n'You can cause an object to move to either one of states programmatically by \r\n'setting the Verb property to the appropriate verb and setting \r\n'Action=OLE_ACTIVATE. \r\n\r\n'Also, if you set AutoActivate = OLE_ACTIVATE_GETFOCUS, the server will \r\n'automatically be put into \"InPlace UI-Active\" state when the user clicks\r\n'on or tabs into the control.\r\n\r\n'VerbFlag Bit Masks \r\nGlobal Const VERBFLAG_GRAYED = &H1\r\nGlobal Const VERBFLAG_DISABLED = &H2\r\nGlobal Const VERBFLAG_CHECKED = &H8\r\nGlobal Const VERBFLAG_SEPARATOR = &H800\r\n\r\n'MiscFlag Bits - Or these together as desired for special behaviors\r\n\r\n'MEMSTORAGE causes the control to use memory to store the object while\r\n' it is loaded. This is faster than the default (disk-tempfile),\r\n' but can consume a lot of memory for objects whose data takes\r\n' up a lot of space, such as the bitmap for a paint program.\r\nGlobal Const OLE_MISCFLAG_MEMSTORAGE = &H1\r\n\r\n'DISABLEINPLACE overrides the control's default behavior of allowing \r\n' in-place activation for objects that support it. If you\r\n' are having problems activating an object inplace, you can\r\n' force it to always activate in a separate window by setting this\r\n' bit\r\nGlobal Const OLE_MISCFLAG_DISABLEINPLACE = &H2\r\n"
"Info": "Const GFSR_SYSTEMRESOURCES = 0\r\nConst GFSR_GDIRESOURCES = 1\r\nConst GFSR_USERRESOURCES = 2\r\nConst WF_WIN286 = &H10\r\nConst WF_WIN386 = &H20\r\n\r\nDeclare Function GetFreeSpace& Lib \"Kernel\" (ByVal wFlags%)\r\nDeclare Function GetFreeSystemResources% Lib \"User\" (ByVal fuSysResource%)\r\nDeclare Function GetWinFlags% Lib \"Kernel\" ()\r\nDeclare Function GetVersion% Lib \"Kernel\" ()"
},
{
"Group": "Memory",
"Item": "Form_Load",
"Info": "Static lngFlag&, intFlag%\r\n\r\nintFlag = GetVersion() And &HFFFF&\r\nlblVersion.Caption = (intFlag And &HFF) & \".\" & CInt(intFlag / 256)\r\n\r\nlngFlag = GetWinFlags()\r\nIf lngFlag And WF_WIN386 Then lblMode.Caption = \"386 Enhanced Mode\"\r\nIf lngFlag And WF_WIN286 Then lblMode.Caption = \"286 Protected Mode\"\r\n'If lngFlag And WF_WLO Then lblMode.Caption = \"Windows emulation in non-Windows system\"\r\n\r\nlblFreeMemory.Caption = Format$(GetFreeSpace(0), \"###,###\") & \" KB Free\"\r\nlblSystemResources.Caption = Format$(GetFreeSystemResources(GFSR_SYSTEMRESOURCES)) & \"%\"\r\nlblGDIResources.Caption = Format$(GetFreeSystemResources(GFSR_GDIRESOURCES)) & \"%\"\r\nlblUserResources.Caption = Format$(GetFreeSystemResources(GFSR_USERRESOURCES)) & \"%\""
},
{
"Group": "List Box",
"Item": "Set Tab Stops",
"Info": "Sub cListSetTabStops (lstIn as Control, intUnits%)\r\n'setup tab stops in list box - intUnits dialog units/character\r\n'tab at character 24 / intUnits\r\n\r\nStatic lRet&\r\nReDim giTabStops%(intUnits - 1)\r\n\r\nFor lRet = 0 to intUnits - 1\r\n giTabStops%(lRet) = lRet * 10 * (lRet + 1)\r\nNext lRet\r\n\r\nlRet& = SendMessage(lstIn.hWnd, LB_SETTABSTOPS, intUnits, giTabStops%(0))\r\n\r\nEnd Sub"
},
{
"Group": "List Box",
"Item": "(General)",
"Info": "Global Const WM_USER = &H400\r\nGlobal Const LB_SETTABSTOPS = (WM_USER + 19)\r\nGlobal Const LB_SETHORIZONTALEXTENT = (WM_USER + 21)\r\n\r\nDeclare Function SendMessage Lib \"User\" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long\r\n"
},
{
"Group": "Text Box",
"Item": "Numbers Only",
"Info": "Sub txtBox_Keypress (KeyASCII as Integer)\r\n'This routine processes numbers only\r\n If KeyASCII = 13 Then\r\n Keyascii = 0\r\n SendKeys \"{TAB}\"\r\n Else\r\n If keyascii >= 48 And keyascii <= 57 Then 'Numbers\r\n ElseIf KeyASCII = 8 Then 'Backspace\r\n Else\r\n 'It is not a number so ignore the keystroke\r\n KeyASCII = 0\r\n End If\r\n End If\r\n\r\nEnd Sub"
},
{
"Group": "Text Box",
"Item": "Upper Case Only",
"Info": "Sub txtBox_Keypress (KeyASCII as Integer)\r\n'Converts all input to the text box to upper case\r\n\r\n If KeyASCII = 13 Then\r\n 'Keeps the keyboard from beeping\r\n KeyASCII = 0\r\n\r\n 'Allows the cursor to move to the next field\r\n SendKeys \"{TAB}\"\r\n Else\r\n KeyASCII = Asc(UCase(Chr$(KeyASCII)))\r\n End If\r\n\r\nEnd Sub"
},
{
"Group": "Text Box",
"Item": "Read Only",
"Info": "Sub txtReadOnly (txtIn as Control, flgIn%)\r\n'Makes a text box read only or re-write depending on flgIn\r\n\r\nStatic lRet%\r\n\r\nlRet = SendMessage(txtIn.hWnd, EM_SETREADONLY, flgIn, 0)\r\n\r\nEnd Sub"
"Info": "Function GetColorFromDialog& (CMDialog as Control, lngColorIn&, strCaption$)\r\n'Returns a color from the common dialog that is passed in\r\n\r\n'set cancel to true\r\nCMDialog.CancelError = True\r\n\r\nOn Error GoTo ErrGetColorFromDialog\r\n\r\nCMDialog.DialogTitle = strCaption\r\nCMDialog.Color = lngColorIn\r\nCMDialog.Flags = CC_RGBINIT\r\nCMDialog.Action = DLG_COLOR\r\n\r\nGetColorFromDialog = CMDialog.Color\r\nExit Sub\r\n\r\nErrGetColorFromDialog:\r\nGetColorFromDialog = -1 'Error flag\r\nExit Sub\r\n\r\nEnd Sub"
},
{
"Group": "Common Dialog",
"Item": "GetFileOpen$",
"Info": "Function GetFileOpen$ (CMDialog As Control, sInitDir$, sCaption$, sDefaultExt$, sFileName$, sFilter$)\r\n'Returns a file name that is selected from the given common dialog\r\n\r\nOn Error GoTo ErrGetFileLoad\r\n\r\nIf sInitDir <> \"\" Then CMDialog.InitDir = sInitDir\r\nCMDialog.CancelError = True\r\nCMDialog.DialogTitle = sCaption\r\nCMDialog.FileName = sFileName\r\nCMDialog.DefaultExt = sDefaultExt\r\nCMDialog.Filter = sFilter\r\nCMDialog.FilterIndex = 1\r\nCMDialog.Action = DLG_FILE_OPEN\r\n\r\nIf InStr(CMDialog.Filename, \"*\") = 0 And CMDialog.Filename <> \"\" And CMDialog.Filename = UCase$(CMDialog.Filename) Then\r\n GetFileOpen = CMDialog.Filename\r\nEnd If\r\n\r\nExit Function\r\n\r\nErrGetFileLoad:\r\nGetFileOpen = \"\"\r\nExit Function\r\nResume\r\n\r\nEnd Function\r\n"
},
{
"Group": "Common Dialog",
"Item": "GetFont",
"Info": "Function SetFont$ (CMDialog As Control, Affected as Control, sCaption$)\r\n'Sets the font on the given control based on the common dialog selection\r\n'Returns the font name\r\n\r\nCMDialog.CancelError = True\r\n\r\nOn Error GoTo ErrGetFont\r\n\r\nCMDialog.DialogTitle = sCaption\r\nCMDialog.FontName = Affected.FontName\r\nCMDialog.FontSize = Affected.FontSize\r\nCMDialog.FontBold = Affected.FontBold\r\nCMDialog.FontItalic = Affected.FontItalic\r\nCMDialog.Flags = CF_SCREENFONTS Or CF_ANSIONLY Or CF_FORCEFONTEXIST\r\nCMDialog.Action = DLG_FONT\r\n\r\nGetFont = CMDialog.FontName\r\nAffected.FontName = CMDialog.FontName\r\nAffected.FontSize = CMDialog.FontSize\r\nAffected.FontBold = CMDialog.FontBold\r\nAffected.FontItalic = CMDialog.FontItalic\r\n\r\nExit Sub\r\n\r\nErrGetFont:\r\nGetFont = \"\"\r\nExit Sub\r\n\r\nEnd Function\r\n"
"Info": "Sub cListHorizontalScrollBar (lstIn as Control)\r\n'Puts a horizontal scroll bar on the given list box\r\n\r\nStatic intCount%\r\nStatic lRet&\r\nStatic strLong$\r\n\r\nstrLong = \"\"\r\nFor intCount = 1 to lstIn.ListCount\r\n If Len(lstIn.List(intCount - 1)) > len (strTemp) then\r\n strLong = lstIn.List(intCount - 1)\r\n End If\r\nNext intCount\r\nintCount% = (TextWidth(strLong + \"0000\") / Screen.TwipsPerPixelX)\r\nlRet = SendMessage(lstIn.hWnd, LB_SETHORIZONTALEXTENT, intCount%, &H0)\r\n\r\nEnd Sub"
},
{
"Group": "Constants",
"Item": "Clipboard formats",
"Info": "''''''''''''''''''''''''''''\r\n' Visual Basic global constant file. This file can be loaded\r\n' into a code module.\r\n'\r\n' Some constants are commented out because they have\r\n' duplicates (e.g., NONE appears several places).\r\n'\r\n' If you are updating a Visual Basic application written with\r\n' an older version, you should replace your global constants\r\n' with the constants in this file.\r\n'\r\n''''''''''''''''''''''''''''\r\n\r\nGlobal Const CF_LINK = &HBF00\r\nGlobal Const CF_TEXT = 1\r\nGlobal Const CF_BITMAP = 2\r\nGlobal Const CF_METAFILE = 3\r\nGlobal Const CF_DIB = 8\r\nGlobal Const CF_PALETTE = 9\r\n"
"Info": "Function GetINIString$ (strFileName$, strSectionName$, strKeyName$, ByVal strDefault$)\r\n 'File, Section, Key Name\r\n Dim Temp As String * 255\r\n Dim intLen%, X%, intRes%\r\n Dim Default$, R$\r\n Default = \"*****\"\r\n intLen = 255\r\n intRes = GetPrivateProfileString(strSectionName, strKeyName, Default, Temp, intLen, strFileName)\r\n If Left$(Temp, 5) = \"*****\" Then\r\n Select Case strDefault\r\n Case \"\"\r\n 'No default was supplied\r\n Do\r\n R = InputBox((strSectionName & \" \" & strKeyName & \" Not Found - Please Enter\"), \"File Error\")\r\n Loop While R <> \"\"\r\n WriteINIString strFileName, strSectionName, strKeyName, R\r\n GetINIString = GetINIString(strFileName, strSectionName, strKeyName, \"\")\r\n Case Chr$(255)\r\n 'Don't return anything if it is not found\r\n GetINIString = \"\"\r\n Case Else\r\n 'Write in the default and return it\r\n WriteINIString strFileName, strSectionName, strKeyName, strDefault\r\n GetINIString = GetINIString(strFileName, strSectionName, strKeyName, strDefault)\r\n End Select\r\n Else\r\n For X = 1 To intLen\r\n If Asc(Mid$(Temp, X, 1)) = 0 Then Exit For\r\n Next X\r\n GetINIString = Left$(Temp, X - 1)\r\n End If\r\nEnd Function"
},
{
"Group": "INI Files",
"Item": "SystemDirectory$ ",
"Info": "Function SystemDirectory$ ()\r\n'Returns the Windows system directory\r\nStatic intSize%, intRes%\r\nStatic strTemp As String * 144\r\n \r\nintSize = 144\r\nintRes = GetSystemDirectory(strTemp, 144)\r\nSystemDirectory = Left$(strTemp, intRes)\r\n\r\nEnd Function"
},
{
"Group": "INI Files",
"Item": "WindowsDirectory$ ",
"Info": "Function WindowsDirectory$ ()\r\n'Returns the Windows directory\r\nStatic intSize%, intRes%\r\nStatic strTemp As String * 144\r\n\r\nintSize = 144\r\nintRes = GetWindowsDirectory(strTemp, 144)\r\nWindowsDirectory = Left$(strTemp, intRes)\r\n\r\nEnd Function"
"Info": "Sub WriteINIString (ByVal strFileName$, ByVal strSectionName$, ByVal strKeyName$, ByVal NewString$)\r\n'Writes a string into the given header and section of the file\r\nStatic Res%\r\n \r\nRes = WritePrivateProfileString(strSectionName, strKeyName, NewString, strFileName)\r\n\r\nEnd Sub"
},
{
"Group": "List Box",
"Item": "Remove By Name",
"Info": "Sub cLstRemoveByName (lstIn as Control, strDelete$)\r\n\r\nStatic intCount%\r\n\r\nFor intCount = 0 to lstIn.ListCount - 1\r\n If lstIn.List(intCount) = strDelete then\r\n lstIn.RemoveItem intCount\r\n End If\r\nNext intCount\r\n\r\nEnd Sub"
},
{
"Group": "Text Replace",
"Item": "(General)",
"Info": "Option Explicit\r\n\r\nGlobal gstrFind$ 'Keep track of last find done\r\nGlobal gtxtIn As Control\r\nGlobal gflgMatchCase% 'Remembers if Match Case was clicked"
},
{
"Group": "Text Replace",
"Item": "ReplaceAllText% ",
"Info": "Function ReplaceAllText% (txtIn As Control, ByVal strFind$, ByVal strReplace$, ByVal flgMatchCase%)\r\n'Replaces all text in a control and returns the number of replacements made\r\n\r\nStatic intStart%, intCount%\r\n\r\ngstrFind = strFind\r\nintStart = 1\r\nintCount = 0\r\n\r\nDo\r\n If InStr(intStart, txtIn.Text, gstrFind, IIf(flgMatchCase = 0, 1, 0)) > 0 Then\r\n txtIn.SelStart = InStr(intStart, txtIn.Text, gstrFind, IIf(flgMatchCase = 0, 1, 0)) - 1\r\n txtIn.SelLength = Len(gstrFind)\r\n txtIn.SelText = strReplace\r\n intStart = txtIn.SelStart + Len(strReplace)\r\n intCount = intCount + 1\r\n Else\r\n Exit Do\r\n End If\r\nLoop\r\n\r\nReplaceAllText = intCount\r\n\r\nEnd Function"
},
{
"Group": "Text Replace",
"Item": "ReplaceOneText% ",
"Info": "Function ReplaceOneText% (txtIn As Control, ByVal strFind$, ByVal strReplace$, ByVal flgMatchCase%)\r\n'Replaces one item in the given text box and returns true if it found anything\r\n\r\nStatic intStart%\r\n\r\ngstrFind = strFind\r\nIf txtIn.SelStart < 1 Then\r\n intStart = 1\r\nElse\r\n intStart = txtIn.SelStart\r\nEnd If\r\n\r\nIf InStr(intStart, txtIn.Text, gstrFind, IIf(flgMatchCase = 0, 1, 0)) > 0 Then\r\n txtIn.SelStart = InStr(intStart, txtIn.Text, gstrFind, IIf(flgMatchCase = 0, 1, 0)) - 1\r\n txtIn.SelLength = Len(gstrFind)\r\n txtIn.SelText = strReplace\r\n txtIn.SelStart = txtIn.SelStart + Len(strReplace)\r\n ReplaceOneText = True\r\nElse\r\n ReplaceOneText = False\r\nEnd If\r\n\r\nEnd Function"
},
{
"Group": "Text Replace",
"Item": "ReplaceText ",
"Info": "Sub ReplaceText (txtIn As Control)\r\n'This is the call from programs to access the replace form\r\n\r\nSet gtxtIn = txtIn\r\n\r\nfrmReplace!txtFind = txtIn.SelText\r\nfrmReplace!txtFind.SelStart = 0\r\nfrmReplace!txtFind.SelLength = Len(txtIn.SelText)\r\nfrmReplace.Show 1\r\n\r\nEnd Sub"
"Info": "'API Declaration\r\nDeclare Function ExitWindows% Lib \"User\" (ByVal dwReserved&, ByVal wReturnCode%)\r\n\r\n'Call from procedure\r\niRet% = ExitWindows(66, 66)"
},
{
"Group": "API",
"Item": "Shell to DOS",
"Info": "Function ShellToDOS& (strCommand$)\r\n\r\nStatic iRet%, iRet2%\r\n\r\niRet% = Shell(strCommand$)\r\nWhile GetModuleUsage(iRet%)\t'checks if shell is still active\r\n iRet2% = DoEvents()\r\nWend\r\n\r\nShellToDOS = iRet%\t'returns task ID or error code\r\n\r\nEnd Function"
